home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / easybr / frmabout.frm (.txt) < prev    next >
Visual Basic Form  |  1999-10-05  |  10KB  |  257 lines
  1. VERSION 5.00
  2. Begin VB.Form frmAbout 
  3.    BorderStyle     =   3  'Fester Dialog
  4.    Caption         =   "About Easy Browser 1.0"
  5.    ClientHeight    =   2610
  6.    ClientLeft      =   2340
  7.    ClientTop       =   1935
  8.    ClientWidth     =   5730
  9.    ClipControls    =   0   'False
  10.    LinkTopic       =   "Form2"
  11.    MaxButton       =   0   'False
  12.    MinButton       =   0   'False
  13.    ScaleHeight     =   1801.468
  14.    ScaleMode       =   0  'Benutzerdefiniert
  15.    ScaleWidth      =   5380.766
  16.    ShowInTaskbar   =   0   'False
  17.    Begin VB.PictureBox picIcon 
  18.       AutoSize        =   -1  'True
  19.       ClipControls    =   0   'False
  20.       Height          =   540
  21.       Left            =   240
  22.       Picture         =   "frmAbout.frx":0000
  23.       ScaleHeight     =   337.12
  24.       ScaleMode       =   0  'Benutzerdefiniert
  25.       ScaleWidth      =   337.12
  26.       TabIndex        =   1
  27.       Top             =   240
  28.       Width           =   540
  29.    End
  30.    Begin VB.CommandButton cmdOK 
  31.       Cancel          =   -1  'True
  32.       Caption         =   "OK"
  33.       Default         =   -1  'True
  34.       Height          =   345
  35.       Left            =   4245
  36.       TabIndex        =   0
  37.       Top             =   1680
  38.       Width           =   1260
  39.    End
  40.    Begin VB.CommandButton cmdSysInfo 
  41.       Caption         =   "&Systeminfo..."
  42.       Height          =   345
  43.       Left            =   4260
  44.       TabIndex        =   2
  45.       Top             =   2160
  46.       Width           =   1245
  47.    End
  48.    Begin VB.Label Label2 
  49.       Caption         =   "itsme123@mail.com"
  50.       ForeColor       =   &H00FF0000&
  51.       Height          =   375
  52.       Left            =   2400
  53.       TabIndex        =   7
  54.       Top             =   2280
  55.       Width           =   1575
  56.    End
  57.    Begin VB.Label Label1 
  58.       Caption         =   "If you have any questions, please send an E-mail to:     "
  59.       Height          =   255
  60.       Left            =   240
  61.       TabIndex        =   6
  62.       Top             =   1920
  63.       Width           =   3975
  64.    End
  65.    Begin VB.Line Line1 
  66.       BorderColor     =   &H00808080&
  67.       BorderStyle     =   6  'Innen ausgef
  68.       Index           =   1
  69.       X1              =   0
  70.       X2              =   5224.884
  71.       Y1              =   828.261
  72.       Y2              =   828.261
  73.    End
  74.    Begin VB.Label lblTitle 
  75.       Caption         =   "Easy Browser 1.0"
  76.       ForeColor       =   &H00000000&
  77.       Height          =   480
  78.       Left            =   1050
  79.       TabIndex        =   4
  80.       Top             =   240
  81.       Width           =   3885
  82.    End
  83.    Begin VB.Line Line1 
  84.       BorderColor     =   &H00FFFFFF&
  85.       BorderWidth     =   2
  86.       Index           =   0
  87.       X1              =   98.6
  88.       X2              =   5309.398
  89.       Y1              =   828.261
  90.       Y2              =   828.261
  91.    End
  92.    Begin VB.Label lblVersion 
  93.       Caption         =   "Version "
  94.       Height          =   225
  95.       Left            =   1050
  96.       TabIndex        =   5
  97.       Top             =   780
  98.       Width           =   3885
  99.    End
  100.    Begin VB.Label lblDisclaimer 
  101.       Caption         =   "Created by Michael Hauck"
  102.       ForeColor       =   &H00000000&
  103.       Height          =   345
  104.       Left            =   255
  105.       TabIndex        =   3
  106.       Top             =   1440
  107.       Width           =   3870
  108.    End
  109. Attribute VB_Name = "frmAbout"
  110. Attribute VB_GlobalNameSpace = False
  111. Attribute VB_Creatable = False
  112. Attribute VB_PredeclaredId = True
  113. Attribute VB_Exposed = False
  114. Option Explicit
  115. ' Registrierungsschl
  116. ssel-Sicherheitsoptionen...
  117. Const READ_CONTROL = &H20000
  118. Const KEY_QUERY_VALUE = &H1
  119. Const KEY_SET_VALUE = &H2
  120. Const KEY_CREATE_SUB_KEY = &H4
  121. Const KEY_ENUMERATE_SUB_KEYS = &H8
  122. Const KEY_NOTIFY = &H10
  123. Const KEY_CREATE_LINK = &H20
  124. Const KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + _
  125.                        KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + _
  126.                        KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL
  127.                      
  128. ' Registrierungsschl
  129. ssel-Stammtypen...
  130. Const HKEY_LOCAL_MACHINE = &H80000002
  131. Const ERROR_SUCCESS = 0
  132. Const REG_SZ = 1                         ' Null-terminierte Unicode-Zeichenfolge
  133. Const REG_DWORD = 4                      ' 32-Bit-Zahl
  134. Const gREGKEYSYSINFOLOC = "SOFTWARE\Microsoft\Shared Tools Location"
  135. Const gREGVALSYSINFOLOC = "MSINFO"
  136. Const gREGKEYSYSINFO = "SOFTWARE\Microsoft\Shared Tools\MSINFO"
  137. Const gREGVALSYSINFO = "PATH"
  138. Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, ByRef phkResult As Long) As Long
  139. Private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByVal lpData As String, ByRef lpcbData As Long) As Long
  140. Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
  141. Private Sub cmdSysInfo_Click()
  142.   Call StartSysInfo
  143. End Sub
  144. Private Sub cmdOK_Click()
  145.   Unload Me
  146. End Sub
  147. Private Sub Form_Load()
  148.     Me.Caption = "Info zu " & App.Title
  149.     lblVersion.Caption = "Version " & App.Major & "." & App.Minor & "." & App.Revision
  150.     lblTitle.Caption = App.Title
  151. End Sub
  152. Public Sub StartSysInfo()
  153.     On Error GoTo SysInfoErr
  154.     Dim rc As Long
  155.     Dim SysInfoPath As String
  156.     ' Versuchen, den Systeminfo-Programmpfad/-namen aus der Registrierung abzurufen...
  157.     If GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFO, gREGVALSYSINFO, SysInfoPath) Then
  158.     ' Versuchen, nur den Systeminfo-Programmpfad aus der Registrierung abzurufen...
  159.     ElseIf GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFOLOC, gREGVALSYSINFOLOC, SysInfoPath) Then
  160.         ' 
  161. berpr
  162. fen, ob bekannte 32-Dateiversion vorhanden ist
  163.         If (Dir(SysInfoPath & "\MSINFO32.EXE") <> "") Then
  164.             SysInfoPath = SysInfoPath & "\MSINFO32.EXE"
  165.             
  166.         ' Fehler - Datei wurde nicht gefunden...
  167.         Else
  168.             GoTo SysInfoErr
  169.         End If
  170.     ' Fehler - Registrierungseintrag wurde nicht gefunden...
  171.     Else
  172.         GoTo SysInfoErr
  173.     End If
  174.     Call Shell(SysInfoPath, vbNormalFocus)
  175.     Exit Sub
  176. SysInfoErr:
  177.     MsgBox "Systeminformationen sind momentan nicht verf
  178. gbar", vbOKOnly
  179. End Sub
  180. Public Function GetKeyValue(KeyRoot As Long, KeyName As String, SubKeyRef As String, ByRef KeyVal As String) As Boolean
  181.     Dim i As Long                                           ' Schleifenz
  182.     Dim rc As Long                                          ' R
  183. ckgabe-Code
  184.     Dim hKey As Long                                        ' Zugriffsnummer f
  185. r einen offenen Registrierungsschl
  186.     Dim hDepth As Long                                      '
  187.     Dim KeyValType As Long                                  ' Datentyp eines Registrierungsschl
  188. ssels
  189.     Dim tmpVal As String                                    ' Tempor
  190. rer Speicher eines Registrierungsschl
  191. sselwertes
  192.     Dim KeyValSize As Long                                  ' Gr
  193. e der Registrierungsschl
  194. sselvariablen
  195.     '------------------------------------------------------------
  196.     ' Registrierungsschl
  197. ssel unter KeyRoot {HKEY_LOCAL_MACHINE...} 
  198. ffnen
  199.     '------------------------------------------------------------
  200.     rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey) ' Registrierungsschl
  201. ssel 
  202. ffnen
  203.     If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError          ' Fehler behandeln...
  204.     tmpVal = String$(1024, 0)                             ' Platz f
  205. r Variable reservieren
  206.     KeyValSize = 1024                                       ' Gr
  207. e der Variable markieren
  208.     '------------------------------------------------------------
  209.     ' Registrierungsschl
  210. sselwert abrufen...
  211.     '------------------------------------------------------------
  212.     rc = RegQueryValueEx(hKey, SubKeyRef, 0, _
  213.                          KeyValType, tmpVal, KeyValSize)    ' Schl
  214. sselwert abrufen/erstellen
  215.                         
  216.     If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError          ' Fehler behandeln
  217.     If (Asc(Mid(tmpVal, KeyValSize, 1)) = 0) Then           ' Win95 f
  218. gt null-terminierte Zeichenfolge hinzu...
  219.         tmpVal = Left(tmpVal, KeyValSize - 1)               ' Null gefunden, aus Zeichenfolge ext